home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / PREDEF1.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  43KB  |  1,821 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /*    +---------------------------------------------------+
  10.       |                                                   |
  11.       |          I N T E R P     P R E D E F S            |
  12.       |                  (C Version)                      |
  13.       |                                                   |
  14.       |   Adapted From Low Level SETL version written by  |
  15.       |                                                   |
  16.       |                  Monte Zweben                     |
  17.       |               Philippe Kruchten                   |
  18.       |               Jean-Pierre Rosen                   |
  19.       |                                                   |
  20.       |    Original High Level SETL version written by    |
  21.       |                                                   |
  22.       |                   Clint Goss                      |
  23.       |               Tracey M. Siesser                   |
  24.       |               Bernard D. Banner                   |
  25.       |               Stephen C. Bryant                   |
  26.       |                  Gerry Fisher                     |
  27.       |                                                   |
  28.       |              C version written by                 |
  29.       |                                                   |
  30.       |               Robert B. K. Dewar                  |
  31.       |                                                   |
  32.       +---------------------------------------------------+ */
  33.  
  34. /* This module contains routines for the implementation of some of
  35.  * the predefined Ada packages and routines, namely SEQUENTIAL_IO,
  36.  * DIRECT_IO, TEXT_IO, and CALENDAR. Part 1 contains the PREDEF
  37.  * routine which executes a predefined operation.
  38. */
  39.  
  40. #include <stdlib.h>
  41. #include <setjmp.h>
  42. #include <string.h>
  43. #include "ipredef.h"
  44. #include "intbp.h"
  45. #include "intcp.h"
  46. #include "predefp.h"
  47.  
  48. /*
  49.  * Environment variable to save stack pointer for PREDEF_RAISE. On entry to
  50.  * PREDEF, raise_env saves the stack environment (using set_jmp). If an Ada
  51.  * exception is signalled, then the PREDEF_RAISE routine raises the exception
  52.  * using the usual raise procedure, and then exits directly at the top level
  53.  * of the PREDEF procedure, using longjmp.
  54.  */
  55.  
  56. jmp_buf raise_env;
  57.  
  58. static int string_offset(int *);
  59.  
  60. /* Procedure called by main interpreter to execute predefined operation. The
  61.  * operation code has been read from the code stream and is passed as the
  62.  * parameter. The remaining parameters are stacked as needed.
  63. */
  64.  
  65. void predef()                                /*;predef*/
  66. {
  67.     /* This procedure handles all predefined operations. It is passed a marker
  68.      * which determines the operation to be performed. The formal parameters of
  69.      * the original call have been evaluted onto CURSTACK, but must not be
  70.      * popped as then will be discarded by the code. In the case of generic
  71.      * procedures, the type template address is pushed on the parameters AND
  72.      *  MUST BE POPPED!
  73.      */
  74.  
  75.     /* First capture environment for use by PREDEF_RAISE */
  76.  
  77.     if (setjmp(raise_env))
  78.         return;
  79.  
  80.     /* Switch on the operation code */
  81.  
  82.     switch(operation) {
  83.  
  84.  
  85.         /* 14.2.1  FILE MANAGEMENT */
  86.  
  87.  
  88.         /* SEQUENTIAL_IO:                                     */
  89.         /* procedure CREATE(FILE  : in out FILE_TYPE;         */
  90.         /*                  MODE  : in FILE_MODE := OUT_FILE; */
  91.         /*                  NAME  : in STRING    := "";       */
  92.         /*                  FORM  : in STRING    := "");      */
  93.  
  94.     case P_SIO_CREATE:
  95.         {
  96.             open_seq_io('C');
  97.             break;
  98.         }
  99.  
  100.  
  101.         /* DIRECT_IO:                                          */
  102.         /* procedure CREATE(FILE : in out FILE_TYPE;           */
  103.         /*                  MODE : in FILE_MODE := INOUT_FILE; */
  104.         /*                  NAME : in STRING    := "";         */
  105.         /*                  FORM : in STRING    := "");        */
  106.  
  107.     case P_DIO_CREATE:
  108.         {
  109.             open_dir_io('C');
  110.             break;
  111.         }
  112.  
  113.  
  114.         /* TEXT_IO:                                           */
  115.         /* procedure CREATE(FILE : in out FILE_TYPE;          */
  116.         /*                  MODE : in FILE_MODE := OUT_FILE;  */
  117.         /*                  NAME : in STRING    := "";        */
  118.         /*                  FORM : in STRING    := "");       */
  119.  
  120.     case P_TIO_CREATE:
  121.         {
  122.             open_textio('C');
  123.             break;
  124.         }
  125.  
  126.  
  127.         /*  SEQUENTIAL_IO:                           */
  128.         /*  procedure OPEN(FILE : in out FILE_TYPE;  */
  129.         /*                 MODE : in FILE_MODE;      */
  130.         /*                 NAME : in STRING;         */
  131.         /*                 FORM : in STRING := "");  */
  132.  
  133.     case P_SIO_OPEN:
  134.         {
  135.             open_seq_io('O');
  136.             break;
  137.         }
  138.  
  139.  
  140.         /* DIRECT_IO:                                */
  141.         /* procedure OPEN(FILE : in out FILE_TYPE;   */
  142.         /*                MODE : in FILE_MODE;       */
  143.         /*                NAME : in STRING;          */
  144.         /*                FORM : in STRING := "");   */
  145.  
  146.     case P_DIO_OPEN:
  147.         {
  148.             open_dir_io('O');
  149.             break;
  150.         }
  151.  
  152.  
  153.         /* TEXT_IO:                                  */
  154.         /* procedure OPEN(FILE : in out FILE_TYPE;   */
  155.         /*                MODE : in FILE_MODE;       */
  156.         /*                NAME : in STRING;          */
  157.         /*                FORM : in STRING := "");   */
  158.  
  159.     case P_TIO_OPEN:
  160.         {
  161.             open_textio('O');
  162.             break;
  163.         }
  164.  
  165.  
  166.         /* procedure CLOSE(FILE : in out FILE_TYPE); */
  167.  
  168.     case P_SIO_CLOSE:
  169.     case P_DIO_CLOSE:
  170.     case P_TIO_CLOSE:
  171.         {
  172.             int    *file_ptr;
  173.  
  174.             file_ptr = get_argument_ptr(0);
  175.             filenum = *file_ptr;
  176.             check_file_open();
  177.  
  178.             *file_ptr = 0;
  179.  
  180.             if (operation == P_SIO_CLOSE || operation == P_DIO_CLOSE)
  181.                 close_file();
  182.             else /* operation == P_TIO_CLOSE */
  183.                 close_textio();
  184.             break;
  185.         }
  186.  
  187.         /*  procedure DELETE(FILE : in out FILE_TYPE); */
  188.  
  189.     case P_SIO_DELETE:
  190.     case P_DIO_DELETE:
  191.     case P_TIO_DELETE:
  192.         {
  193.             int    *file_ptr;
  194.  
  195.             file_ptr = get_argument_ptr(0);
  196.             filenum = *file_ptr;
  197.             check_file_open();
  198.  
  199.             strcpy(work_string, IOFNAME);
  200.  
  201.             if (operation == P_SIO_DELETE || P_DIO_DELETE)
  202.                 close_file();
  203.             else /* operation == P_TIO_DELETE */
  204.                 close_textio();
  205.             unlink(work_string);
  206.  
  207.             *file_ptr = 0;
  208.             break;
  209.         }
  210.  
  211.  
  212.         /*  SEQUENTIAL_IO:                                                 */
  213.         /*  procedure RESET(FILE : in out FILE_TYPE; MODE : in FILE_MODE); */
  214.         /*  procedure RESET(FILE : in out FILE_TYPE);                      */
  215.  
  216.     case P_SIO_RESET:
  217.     case P_SIO_RESET_MODE:
  218.         {
  219.             int    newmode;
  220.  
  221.             DISCARD_GENERIC_PARAMETER;
  222.             get_filenum();
  223.             check_file_open();
  224.  
  225.             if (operation == P_SIO_RESET_MODE) {
  226.                 newmode = get_argument_value(2);
  227.             }
  228.             else
  229.                 newmode = IOMODE;
  230.  
  231.             fclose(IOFDESC);
  232.  
  233.             if (newmode == SIO_IN_FILE) {
  234.                 IOFDESC = fopen_bin(IOFNAME, "r");
  235.                 check_opened_ok();
  236.             }
  237.             else {
  238.                 IOFDESC = fopen_bin(IOFNAME, "r+");
  239.                 check_opened_ok();
  240.             }
  241.             IOMODE = newmode;
  242.             break;
  243.         }
  244.  
  245.         /* DIRECT_IO:                                                       */
  246.         /* procedure RESET (FILE : in out FILE_TYPE;  MODE : in FILE_MODE); */
  247.         /* procedure RESET (FILE : in out FILE_TYPE);                       */
  248.  
  249.     case P_DIO_RESET:
  250.     case P_DIO_RESET_MODE:
  251.         {
  252.             int    newmode;
  253.  
  254.             DISCARD_GENERIC_PARAMETER;
  255.             get_filenum();
  256.  
  257.             check_file_open();
  258.  
  259.             if (operation == P_DIO_RESET_MODE)
  260.                 newmode = get_argument_value(2);
  261.             else
  262.                 newmode = IOMODE;
  263.  
  264.             fclose(IOFDESC);
  265.  
  266.             if (newmode == DIO_IN_FILE) {
  267.                 IOFDESC = fopen_bin(IOFNAME, "r");
  268.             }
  269.             else {
  270.                 IOFDESC = fopen_bin(IOFNAME, "r+");
  271.             }
  272.             check_opened_ok();
  273.  
  274.             IOMODE = newmode;
  275.             DPOS = 1;
  276.             break;
  277.         }
  278.  
  279.         /* TEXT_IO:                                                       */
  280.         /* procedure RESET(FILE : in out FILE_TYPE; MODE : in FILE_MODE); */
  281.         /* procedure RESET(FILE : in out FILE_TYPE);                      */
  282.  
  283.     case P_TIO_RESET:
  284.     case P_TIO_RESET_MODE:
  285.         {
  286.             int     newmode;
  287.  
  288.             get_filenum();
  289.             check_file_open();
  290.  
  291.             if (operation == P_TIO_RESET_MODE) {
  292.                 newmode = get_argument_value(2);
  293.  
  294.                 /* Raise MODE_ERROR on attempt to change the mode of the
  295.                  * current default input or output file. */
  296.  
  297.                 if ((filenum == current_in_file || filenum == current_out_file)
  298.                   && newmode != IOMODE)